#lang racket


(require "../ast/main.rkt"
         "../backends/main.rkt"
         "../base/main.rkt"
         "../proxies/main.rkt")

(require (prefix-in met: "rh-methods.rkt"))

(provide rhino-backend%)


(define rhino-proxy%
  (class* generic-proxy% ()
    (super-new)
    
    (met:load-rhino-methods)
    
    (define-impl-methods
      ; shapes
      ((bbox shape) met:bbox)
      
      ; points
      ((point c) met:point)
      
      ((point? shape) met:point?)
      
      ((point-c shape) met:point-c)
      
      ; lines
      ((arc angle radius) met:arc)
      ((elliptical-arc angle x-radius y-radius) met:elliptical-arc)
      ((ellipse x-radius y-radius) met:ellipse)
      ((line closed? coords) met:line)
      ((spline closed? cs type) met:spline)
      
      ((line? shape) met:line?)
      ((line-closed? shape) met:line-closed?)
      
      ((line-begin-c shape) met:line-begin-c)
      ((line-end-c shape) met:line-end-c))
    
    ; surfaces
    (define/override (ngon width sides) (met:ngon (surface-primitive-type) width sides))
    
    (define-impl-methods
      ((surface shapes) met:surface)
      
      ((surface? shape) met:surface?)
      
      ((surface-curvature shape) met:surface-curvature)
      ((surface-domain shape) met:surface-domain)
      
      ; solids
      ((box width length height) met:box)
      ((cone radius height) met:cone)
      ((cone-frustum base-radius top-radius height) met:cone-frustum)
      ((cylinder radius height) met:cylinder)
      ((pyramid width sides height) met:pyramid)
      ((sphere radius) met:sphere)
      
      ((solid? shape) met:solid?)
      
      ; generic shapes
      ((circle c type radius) met:circle)
      ((rectangle type width length) met:rectangle)
      
      ; text
      
      ; transformations
      ((extrude length dir shape) met:extrude)
      ((intersect shapes) met:intersect)
      ((join shapes) met:join)
      ((loft loft-type loft-fit-type closed? shapes) met:loft)
      ((move position shape) met:move)
      ((rotate angle normal shape) met:rotate)
      ((scale type c shape/shapes) met:scale)
      ((section type plane shape) met:section)
      ((slice shape1 shape2) met:slice)
      ((subtract shapes) met:subtract)
      ((sweep path shape) met:sweep)
      ((thicken distance shape) met:thicken)
      ((union shapes) met:union)
      
      ; lang
      ((par shape) met:par)
      
      ; cad
      ((clone-shape shape) met:clone-shape)
      ((clone-shapes shapes) met:clone-shapes)
      ((delete-shape shape) met:delete-shape)
      ((delete-shapes) met:delete-shapes)
      ((get-shapes) met:get-shapes))
    
    (define/override (layer name shape/shapes) shape/shapes)
    
    (define-impl-methods
      ((prompt-point message) met:prompt-point)
      ((prompt-shape message) met:prompt-shape)
      ((render-shapes width height path type) met:render-shapes)
      ((select-shape shape) met:select-shape)
      ((select-shapes shapes) met:select-shapes)
      ((unselect-all-shapes) met:unselect-all-shapes)
      ((valid-shape? shape) met:valid-shape?)
      ((view type projection-type style shape/shapes) met:view))))

(define rhino-evaluator%
  (class* evaluator-visitor% ()
    (super-new)
    
    (define/override (visit-layer node)
      (let ((layer (met:current-layer)))
        (met:current-layer (met:ensure-layer (get-field name node)))
        (begin0
          (super visit-layer node)
          (met:current-layer layer))))))

(define rhino-backend%
  (class* proxy-backend% ()
    (let* ((proxy (new rhino-proxy%))
           (evaluator (new rhino-evaluator% (backend this))))
      (super-new (evaluator evaluator) (proxy proxy)))
    
    ; evaluate
    
    (define/override (evaluate expr)
      (met:replace-defers (super evaluate expr)))

    ; edit: possible optimization: do not invoke 'enable-redraw' unless absolutely necessary
    (define/override (evaluate-toplevel expr)
      (met:enable-redraw #f)
      (finally
       (super evaluate-toplevel expr)
       (λ () (met:enable-redraw #t))))))